home *** CD-ROM | disk | FTP | other *** search
/ Computer Select (Limited Edition) / Computer Select.iso / pcmag / v10n16 / hc.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-06-26  |  4.6 KB  |  170 lines
  1. {$A+,B-,D-,E-,F+,G-,I+,L-,N-,R-,S-,V-,X-}
  2. {$M 16384,0,0}
  3. PROGRAM HugeCalc;
  4. USES Calc;
  5. CONST
  6.   Copyright : String[86] = 'HUGECALC 1.0, Copyright '+
  7.   '(c) 1991 by Neil J. Rubenking'#13#10'PC Magazine '#254+
  8.   ' Neil J. Rubenking';
  9.   NeedComma : Boolean = FALSE;
  10.  
  11.   FUNCTION AllNums(VAR A : String) : Boolean;
  12.   (* Strips commas; TRUE if string is all numeric *)
  13.   VAR N : Byte;
  14.   BEGIN
  15.     AllNums := FALSE;
  16.     FOR N := length(A) DOWNTO 1 DO
  17.       CASE A[N] OF
  18.         '0'..'9' : ;
  19.         ','      : BEGIN
  20.                      Move(A[succ(N)], A[N], length(A)-N);
  21.                      Dec(A[0]);
  22.                    END;
  23.         ELSE Exit;
  24.       END;
  25.     AllNums := A <> '';
  26.   END;
  27.  
  28.   FUNCTION IsDevice(VAR F : Text) : Boolean; Assembler;
  29.   ASM
  30.     MOV AH, 44h      {IOCTL function}
  31.     MOV AL, 00h      {get device info subfunction}
  32.     LES DI, F
  33.     MOV BX, ES:[DI]  {handle in BX}
  34.     INT 21h
  35.     MOV AL, 0        {return value is FALSE}
  36.     JC @end
  37.     TEST DX, 80h     {check is-device bit}
  38.     JZ @end          {if NOT set, just end}
  39.     INC AL           {return value is TRUE}
  40.     @end:
  41.   END;
  42.  
  43. VAR op, opRand, rem : String;
  44.     operation   : Char;
  45.  
  46.   FUNCTION GotParams : Boolean;
  47.     { PURPOSE : Returns true if parameters are
  48.       correctly passed on the command line -- and
  49.       assigns them to the correct variables if so.}
  50.   VAR S      : String[1];
  51.       B      : Byte;
  52.  
  53.     PROCEDURE ErrorOut(S : String);
  54.     BEGIN
  55.       IF IsDevice(Output) THEN
  56.         BEGIN
  57.           WriteLn(Copyright); WriteLn;
  58.           WriteLn(S);
  59.         END
  60.       ELSE WriteLn('*ERROR*');
  61.       Halt(1);
  62.     END;
  63.  
  64.   BEGIN
  65.     GotParams := FALSE;
  66.     B := 2;
  67.     IF (NOT IsDevice(Input)) AND NOT EoF(Input) THEN
  68.       BEGIN
  69.         ReadLn(Op);
  70.         Dec(B);
  71.       END;
  72.     IF (ParamStr(ParamCount) = '/c') OR
  73.        (ParamStr(ParamCount) = '/C') THEN
  74.       NeedComma := TRUE
  75.     ELSE NeedComma := IsDevice(Output);
  76.     IF ParamCount < B THEN
  77.       ErrorOut('Enter "HC ## op ##", where op is +,-,*,/, '+
  78.                'or ^'#13#10'   or "HC ## !" for factorial');
  79.     IF B = 2 THEN op := ParamStr(1);
  80.     IF NOT AllNums(op) THEN
  81.       ErrorOut('Not a positive integer: "'+op+'"');
  82.     S := ParamStr(B);
  83.     operation := S[1];
  84.     CASE operation OF
  85.       '!' : ;
  86.       '+', '-', '*', '/', '^' : BEGIN
  87.         IF ParamCount < succ(B) THEN
  88.           ErrorOut('The operator '+operation+
  89.                     ' requires a second operand.');
  90.         Oprand := ParamStr(B+1);
  91.         IF NOT AllNums(OpRand) THEN
  92.           ErrorOut('Not a positive integer: "'+OpRand+'"');
  93.       END;
  94.       ELSE ErrorOut('Valid operations are +,-,*,/, ! and ^');
  95.     END;
  96.     GotParams := TRUE;
  97.   END;
  98.  
  99.   FUNCTION AddComma(WW : String) : String;
  100.   VAR posn, MinLoc : Word;
  101.   BEGIN
  102.     posn := succ(length(WW));
  103.     MinLoc := 4;
  104.     IF WW[1] = '-' THEN Inc(MinLoc);
  105.     WHILE (posn > MinLoc) AND (length(WW) < 255) DO
  106.       BEGIN
  107.         Dec(posn, 3);
  108.         Move(WW[posn],
  109.              WW[succ(posn)],
  110.              succ(length(WW)-posn));
  111.         WW[posn] := ',';
  112.         Inc(WW[0]);
  113.       END;
  114.     AddComma := WW;
  115.   END;
  116.  
  117.   PROCEDURE ResultOut(result : String);
  118.   BEGIN
  119.     IF result = '' THEN
  120.       BEGIN
  121.         WriteLn('*OVERFLOW*');
  122.         Halt(2);
  123.       END;
  124.     IF NeedComma THEN WriteLn(AddComma(result))
  125.     ELSE WriteLn(Result);
  126.   END;
  127.  
  128. BEGIN
  129.   IF GotParams THEN
  130.     BEGIN
  131.       CASE operation OF
  132.         '+' : BEGIN
  133.                 IF IsDevice(Output) THEN
  134.                   Write('       SUM: ');
  135.                 ResultOut(add(op, opRand));
  136.               END;
  137.         '-' : BEGIN
  138.                 IF IsDevice(Output) THEN
  139.                   Write('DIFFERENCE: ');
  140.                 ResultOut(sub(op, opRand));
  141.               END;
  142.         '*' : BEGIN
  143.                 IF IsDevice(Output) THEN
  144.                   Write('   PRODUCT: ');
  145.                 ResultOut(prod(op, opRand));
  146.               END;
  147.         '/' : BEGIN
  148.                 IF IsDevice(Output) THEN
  149.                   Write(' QUOTIENT: ');
  150.                 ResultOut(divide(op, opRand, rem));
  151.                 IF IsDevice(Output) THEN
  152.                   BEGIN
  153.                     Write('REMAINDER: ');
  154.                     WriteLn(AddComma(rem));
  155.                   END;
  156.               END;
  157.         '!' : BEGIN
  158.                 IF IsDevice(Output) THEN
  159.                   Write(' FACTORIAL: ');
  160.                 ResultOut(fact(op));
  161.               END;
  162.         '^' : BEGIN
  163.                 IF IsDevice(Output) THEN
  164.                   Write('     POWER: ');
  165.                 ResultOut(power(op, oprand));
  166.               END;
  167.       END;
  168.     END;
  169. END.
  170.